unit DB.Base;

interface

uses
  FireDAC.Comp.Client, FireDAC.Comp.DataSet, data.DB, Rtti, system.SysUtils,
  db.DM;

type
  TDBBase = class(TInterfacedObject)
  private
    dm: TDM;
  protected
    function Q(s: string): string;
    procedure SetValue(obj, from: TObject);
    procedure Query(sql: string; memtable: TFDMemTable);
    function ExecSQL(sql: string): Boolean;
    procedure ApplyPost(PrimaryKey, tablename: string; DataSet: TFDDataSet);
    procedure DeletePost(PrimaryKey, tablename: string; DataSet: TDataSet);
    procedure StartTransaction;
    procedure Commit;
    procedure Rollback;
    constructor Create;
    destructor Destroy; override;
  end;

implementation



{ TDBBase }

procedure TDBBase.Commit;
begin
  dm.Commit;
end;

constructor TDBBase.Create;
begin
  dm := Tdm.Create(nil);
end;

procedure TDBBase.DeletePost(PrimaryKey, tablename: string; DataSet: TDataSet);
begin
  DM.DeletePost(PrimaryKey, tablename, DataSet);
end;

destructor TDBBase.Destroy;
begin
  dm.Free;
  inherited;
end;

function TDBBase.ExecSQL(sql: string): Boolean;
begin
  Result := DM.ExecSQL(sql);
end;

procedure TDBBase.ApplyPost(PrimaryKey, tablename: string; DataSet: TFDDataSet);
begin

  DM.ApplyPost(PrimaryKey, tablename, DataSet);
end;

procedure TDBBase.Query(sql: string; memtable: TFDMemTable);
begin

  DM.Query(sql, memtable);
end;

procedure TDBBase.Rollback;
begin
  dm.Rollback;
end;

function TDBBase.Q(s: string): string;
begin
  Result := QuotedStr(s);
end;

procedure TDBBase.SetValue(obj, from: TObject);
var
  c: TRttiContext;
  t1, t2: TRttiType;
  arr: TArray<TRttiProperty>;
  item, item2: TRttiProperty;
  name: string;
  value: TValue;
begin
  c := TRttiContext.Create;
  t1 := c.GetType(from.ClassType);
  t2 := c.GetType(obj.ClassType);
  arr := t1.GetProperties;
  for item in arr do
  begin

    name := item.name;
    if (item.IsWritable) then
    begin
      value := item.GetValue(from).CastToVarRec;
      item2 := t2.GetProperty(name);
      if item2 <> nil then
        item2.SetValue(obj, value);
    end;
  end;
end;

procedure TDBBase.StartTransaction;
begin
  dm.StartTransaction;
end;

end.

